      SUBROUTINE THH(SMAT,PKROW,NCOLA1,RMAT,MRY,NOY,NOSTOC,ROWS,DPSOS,
     X                 FILMOD)
C
C***   THIS SUBROUTINE PERFORMS A DOUBLE PRECISION TRIANGULARIZATION OF A
C***  RECTANGULAR MATRIX INTO A SINGLY-SUBSCRIPTED ARRAY BY APPLICATION OF
C***  HOUSEHOLDER ORTHONORMAL TRANSFORMATIONS.
C
      INTEGER PKROW,ROWS
      DOUBLE PRECISION SMAT(PKROW,NCOLA1),RMAT(MRY)
      DOUBLE PRECISION ZERO,ONE,SUM,DELTA,BETA,   DPSOS
       DATA ZERO/0.D0/, ONE/1.D0/
C
C
C
C
       NP6=NOSTOC+6
       NY1= NOY + 1
       NC=NOY
C
C   IF FILMOD=0, DATA RECORDS ARE STORED IN SMAT TO BE PACKED INTO
C   RMAT.   SET THE COUNTERS RIGHT.
C   ..
       IF(FILMOD.NE.0) GO TO 10
       NC = NCOLA1 - 1
       NP6=0
       NY1=NCOLA1
   10 KK= 1
      DO 500 J=1,NC
      SUM = RMAT(KK)**2
      DO 20 I=1,ROWS
   20 SUM = SUM + SMAT(NP6 + I,NP6+J)**2
      IF(SUM.LE.ZERO) GO TO 500
      SUM = DSQRT(SUM)
      IF(RMAT(KK).GT.ZERO) SUM = - SUM
      DELTA = RMAT(KK) - SUM
      RMAT(KK) = SUM
      BETA = ONE/(SUM*DELTA)
      JJ = KK
      L= J
      J1 = J+1
      DO 40 K=J1,NY1
      JJ = JJ + L
      L = L + 1
      SUM = DELTA*RMAT(JJ)
      DO 35 I=1,ROWS
   35 SUM = SUM + SMAT(NP6+I,NP6+J)*SMAT(NP6+I,NP6+K)
      IF(SUM.EQ.ZERO) GO TO 40
      SUM = SUM*BETA
      RMAT(JJ) = RMAT(JJ) + SUM*DELTA
      DO 36 I=1,ROWS
   36 SMAT(NP6+I,NP6+K) = SMAT(NP6+I,NP6+K) + SUM*SMAT(NP6+I,NP6+J)
   40 CONTINUE
  500 KK=KK+J+1
C
C  CALCULATE DPSOS******
C  ..
      NP61 = NP6+1
      NN = NP61 + ROWS
      DELTA = ZERO
      DO 550 I=NP61,NN
 550  DELTA = DELTA + SMAT(I,NCOLA1) * SMAT(I,NCOLA1)
C
      DPSOS = DSQRT (DPSOS*DPSOS + DELTA)
C
      RETURN
      END
